home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / vhf / qw131 / qwctiaru.pas < prev    next >
Pascal/Delphi Source File  |  1991-09-20  |  11KB  |  415 lines
  1. { ****************************************************************************
  2.   ***                                                                      ***
  3.   ***     QWCTIARU.PAS         Converts CT CQWW LOG.ALL TO IARU HF World   ***
  4.   ***                          Championship Log                            ***
  5.   ***                                                                      ***
  6.   ***     Mario H. Fietz, N0LAZ        Version 1.0              15-JUL-91  ***
  7.   ***                                                                      ***
  8.   **************************************************************************** }
  9.  
  10. PROGRAM Qwctiaru;
  11.  
  12. USES Crt;
  13.  
  14. CONST yar  = 99;
  15.       yhqb = '     ';
  16.       yvers = 'K1EA CT CQWW > N0LAZ QW IARU V 1.0 (C) 1991';
  17.  
  18. VAR yhqstn                  : ARRAY[1..yar] OF String[14];  { HQ-Call        }
  19.     yhqrpt                  : ARRAY[1..yar] OF String[5];   { HQ-RPRT        }
  20.     yczne                   : ARRAY[1..300] OF STRING[4];   { Check Zone     }
  21.     yhq,ypge                : INTEGER;                      { HQ-stn counter }
  22.     ysumq,ysumz,ysumc,ysump : ARRAY[0..7] OF LongInt;
  23.     yyr                     : STRING[2];
  24.     yfile                   : STRING[14];
  25.     iaru                    : TEXT;
  26.     ytqso                   : LongInt;          { total qso   }
  27.     ytzne                   : LongInt;          { total zones }
  28.     ythq                    : LongInt;          { total HQs   }
  29.     ytpts                   : LongInt;          { total pts   }
  30.  
  31. {-------------------------------------------------- Ini ---------------------}
  32.  
  33. PROCEDURE Ini;
  34. VAR yn : INTEGER;
  35. BEGIN
  36.   ypge:=0; ytqso:=0; ytzne:=0; ythq:=0; ytpts:=0;
  37.   FOR yn:=1 TO 300 DO yczne[yn]:='';
  38.   FOR yn:=0 TO 7 DO
  39.     BEGIN
  40.     ysumq[yn]:=0;
  41.     ysump[yn]:=0;
  42.     ysumc[yn]:=0;
  43.     ysumz[yn]:=0
  44.     END
  45. END;
  46.  
  47.  
  48. {-------------------------------------------------- HQ Stn INPUT ------------}
  49.  
  50.  
  51. PROCEDURE SumIn (yiband, ynzne, ynclb, ypts : INTEGER);
  52. VAR yi : INTEGER;
  53. BEGIN
  54.   yi:=0;
  55.   CASE yiband OF
  56.     60 : yi:=1;
  57.     80 : yi:=2;
  58.     40 : yi:=3;
  59.     20 : yi:=4;
  60.     15 : yi:=5;
  61.     10 : yi:=6
  62.   END;
  63.  
  64.   ysumq[yi]:=ysumq[yi]+1;
  65.   ysumz[yi]:=ysumz[yi]+ynzne;
  66.   ysumc[yi]:=ysumc[yi]+ynclb;
  67.   ysump[yi]:=ysump[yi]+ypts;
  68.  
  69.   ysumq[ 7]:=ysumq[ 7]+1;
  70.   ysumz[ 7]:=ysumz[ 7]+ynzne;
  71.   ysumc[ 7]:=ysumc[ 7]+ynclb;
  72.   ysump[ 7]:=ysump[ 7]+ypts
  73.  
  74. END;
  75.  
  76.  
  77. {-------------------------------------------------- EXCPT H -----------------}
  78.  
  79. PROCEDURE LogH(ymy,yclss : STRING);
  80. CONST yhd = '                      IARU HF World Championship ';
  81. VAR   yho : STRING;
  82. BEGIN
  83.   ypge:=ypge+1;
  84.   Writeln(iaru,yhd+yyr);
  85.    Writeln(iaru,' ');
  86.   Writeln(iaru,'     PAGE : ',ypge:3,'   Callsign : ',ymy,'  Class : ',yclss);
  87.   Writeln(iaru,' ');
  88.   Writeln(iaru,'                                                          nw  new');
  89.   Writeln(iaru,' BAND MODE   DATE    UTC      Call       send    rcvd     Zn   HQ    Pts');
  90.   Writeln(iaru,' ---- ---- -------- ----- ------------- ------ ---------  --  -----  ---');
  91.   Writeln(iaru,' ');
  92. END;
  93.  
  94. {-------------------------------------------------- EXCPT F -----------------}
  95.  
  96. PROCEDURE LogF(var ydup,ypqso,ypzne,ypclb,yppts : INTEGER;ylast : BOOLEAN);
  97. Const yb1 = '                        ';
  98. BEGIN
  99.   ypqso:=ypqso-ydup;
  100.   ytqso:=ytqso+ypqso;
  101.   ytzne:=ytzne+ypzne;
  102.   ythq :=ythq +ypclb;
  103.   ytpts:=ytpts+yppts;
  104.  
  105.   Writeln(iaru,' ');
  106.   Writeln(iaru,'Total This Page   :       ',ypqso:5,yb1,ypzne:5,ypclb:5,' ',yppts:5);
  107.   Writeln(iaru,' ');
  108.   Writeln(iaru,'Cumulative Totals :       ',ytqso:5,yb1,ytzne:5,ythq:5,' ',ytpts:5);
  109.   IF ylast=True THEN
  110.     BEGIN
  111.     Writeln(iaru,' ');
  112.     Writeln(iaru,yvers)
  113.     END;
  114.   Writeln(iaru,Chr(12));
  115.  
  116.   ydup:=0; ypqso:=0; ypzne:=0; ypclb:=0; yppts:=0;
  117.  
  118. END;
  119.  
  120.  
  121. {-------------------------------------------------- HQ Stn INPUT ------------}
  122.  
  123.  
  124. PROCEDURE In_Hq;
  125. VAR stn           : TEXT;
  126.     yhqstr        : STRING;
  127.     yblank        : INTEGER;
  128.  
  129. BEGIN
  130.   yhq:=0;
  131.   Assign (stn,'HQ.STN');
  132.   {$I-}
  133.   Reset (stn);
  134.   {$I+}
  135.   IF IOResult = 0 THEN
  136.     BEGIN
  137.     WHILE NOT Eof(stn) DO
  138.       BEGIN
  139.       Readln(stn,yhqstr);
  140.       yblank:=Pos(' ',yhqstr);
  141.       yhq:=yhq+1;
  142.       yhqstn[yhq]:=Copy(yhqstr,1,yblank-1);
  143.       yhqrpt[yhq]:=Copy(yhqstr,yblank+1,(Length(yhqstr)-Length(yhqstn[yhq])-1));
  144.       WHILE Length(yhqrpt[yhq])<Length(yhqb) DO
  145.     yhqrpt[yhq]:=yhqrpt[yhq]+' ';
  146.       Writeln(yhqstn[yhq],' > ',yhqrpt[yhq]);
  147.       END
  148.     END
  149. END;
  150.  
  151.  
  152. {-------------------------------------------------------- Check HQ-Stns -----}
  153.  
  154.  
  155. FUNCTION HqRprt (ycall : STRING) : STRING;
  156. VAR yn : INTEGER;
  157. BEGIN
  158.   HqRprt:=yhqb;
  159.   FOR yn:=1 TO yhq DO
  160.     IF ycall=yhqstn[yn] THEN HqRprt:=yhqrpt[yn]
  161. END;
  162.  
  163.  
  164. {-------------------------------------------------------- Check Zones -------}
  165.  
  166.  
  167. FUNCTION CheckZone (yband,yzone : STRING) : STRING;
  168. VAR yn  : INTEGER;
  169.     yb  : BOOLEAN;
  170.     ybz : STRING[4];
  171. BEGIN
  172.  
  173.   yb:=False;
  174.   yn:=0;
  175.   REPEAT
  176.   yn:=yn+1;
  177.   ybz:=yband+yzone;
  178.   IF yczne[yn]='' THEN
  179.     BEGIN
  180.     yczne[yn]:=ybz;
  181.     CheckZone:=yzone;
  182.     yb:=True
  183.     END
  184.   ELSE
  185.     BEGIN
  186.     IF yczne[yn]=ybz THEN
  187.       BEGIN
  188.       CheckZone:='  ';
  189.       yb:=True
  190.       END
  191.     END
  192.   UNTIL (yb=True)
  193. END;
  194.  
  195.  
  196. {-------------------------------------------------------- Read CT Log --------}
  197.  
  198.  
  199. PROCEDURE ReadLog;
  200. VAR 
  201.     ysl,ypts                    : STRING[1];
  202.     yutc,ysnd                   : STRING[4];
  203.     yhqclub                     : STRING[5];
  204.     ydate,ym                    : STRING[8];
  205.     ycall,ymy                   : STRING[16];
  206.     ysrprt                      : STRING[40];
  207.     yrzone,ynzon,ymyzone,yband  : STRING[2];
  208.     yzone                       : STRING[5];
  209.     y1st,yclss                  : STRING[60];
  210.     yctlog                      : STRING;
  211.     ct                          : TEXT;
  212.     yipts                       : BYTE;             { qso   pts  }
  213.     ydup                        : INTEGER;          { dupes      }
  214.     yppts                       : INTEGER;          { page  pts  }
  215.     yphq                        : INTEGER;          { page  HQ   }
  216.     ypzn                        : INTEGER;          { page  Zone }
  217.     ycode,yclb,yiband,yisnd     : INTEGER;
  218.     ynzne,ynclb,yqsoc           : INTEGER;
  219.     ycallsign                   : STRING[8];
  220.     yfirst,ydupe                : BOOLEAN;
  221.  
  222. BEGIN
  223.   yipts:=0; yppts:=0; ydup:=0;
  224.   yphq :=0;
  225.   ypzn :=0;
  226.   yqsoc:=40;
  227.   yfirst:=True;
  228.  
  229.  
  230.   yfile  :=ParamStr(1);
  231.   ymyzone:=ParamStr(2);
  232.   yclss  :=ParamStr(3);
  233.   ymy:='';
  234.  
  235.   Assign (iaru,yfile+'.WCL');
  236.   Rewrite(iaru);
  237.  
  238.   Assign (ct,yfile+'.ALL');
  239.   {$I-}
  240.   Reset (ct);
  241.   {$I+}
  242.   IF IOResult > 0 THEN
  243.     Writeln ('Cannot open ',yfile,'.ALL !')
  244.   ELSE
  245.     BEGIN
  246.      While NOT Eof(ct) DO
  247.       BEGIN
  248.       Readln(ct,yctlog);
  249.  
  250.       ysl:=Copy(yctlog,8,1);
  251.       ycallsign:=Copy(yctlog,13,8);
  252.     IF ycallsign='CALLSIGN' THEN ymy:=Copy(yctlog,23,12);
  253.  
  254.       IF ysl='/' THEN                                       { a qso }
  255.     BEGIN
  256.     ydupe:=False;
  257.     IF yqsoc=40 THEN
  258.       BEGIN
  259.       IF yfirst=False THEN
  260.         LogF(ydup,yqsoc,ypzn,yphq,yppts,False)
  261.       ELSE
  262.         yfirst:=False;
  263.       yyr:=Copy(yctlog,12,2);
  264.       yqsoc:=0;
  265.       LogH(ymy,yclss);
  266.       END;
  267.     yqsoc:=yqsoc+1;
  268.     ydate:=Copy(yctlog,06,08);
  269.     yutc :=Copy(yctlog,16,04);
  270.     yband:=Copy(yctlog,33,02);
  271.     ycall:=Copy(yctlog,36,12);
  272.     yclb:=Pos(' ',ycall);
  273.     ycall:=Copy(ycall,1,yclb-1);
  274.  
  275.     ysnd :=Copy(yctlog,49,03);
  276.     Val(ysnd,yisnd,ycode);
  277.     yzone:=Copy(yctlog,53,02);
  278.     yrzone:=yzone;
  279.     ynzon:=Copy(yctlog,59,02);
  280.     IF ynzon=' ' THEN ynzne:=0 ELSE ynzne:=1;
  281.     ypts :=Copy(yctlog,71,01);
  282.     y1st :=Copy(yctlog,01,60);
  283.  
  284.     IF ynzon='-D' THEN
  285.       BEGIN
  286.       ypts:='0';
  287.       ydupe:=True;
  288.       ydup:=ydup+1
  289.       END
  290.     ELSE
  291.       BEGIN
  292.  
  293.       ynzon:=CheckZone(yrzone,yband);
  294.  
  295.       IF yzone=ymyzone THEN ypts:='1'
  296.       ELSE
  297.         IF (ypts='1') AND (yzone<>ymyzone) THEN ypts:='3'
  298.         ELSE
  299.           IF ypts='3' THEN ypts:='5';
  300.  
  301.       VAL(ypts,yipts,ycode);
  302.       yppts:=yppts+yipts;
  303.  
  304.       yhqclub:=HqRprt(ycall);
  305.       IF yhqclub<>yhqb THEN
  306.         BEGIN
  307.         ypts:='1';
  308.         yphq:=yphq+1;                      { Page HQ Counter }
  309.         yzone:=yhqclub;
  310.         ynclb:=1
  311.         END
  312.       ELSE
  313.         ynclb:=0;
  314.  
  315.       IF ynzon<>'  ' THEN
  316.         BEGIN
  317.         ypzn:=ypzn+1;                      { Page Zone Counter }
  318.         ynzne:=1
  319.         END
  320.       ELSE
  321.         ynzne:=0;
  322.  
  323.       VAL(yband,yiband,ycode);
  324.  
  325.       SumIn(yiband,ynzne,ynclb,yipts);
  326.         END;
  327.  
  328.     WHILE Length(yzone)<5 DO yzone:=yzone+' ';
  329.  
  330.     IF yisnd<100 THEN
  331.       BEGIN
  332.       ym:=' SSB  ';
  333.       ysrprt:=' 59  '+ymyzone+' '+ysnd+' '+yzone
  334.       END
  335.     ELSE
  336.       BEGIN
  337.       ym:='  CW  ';
  338.       ysrprt:=' 599 '+ymyzone+' '+ysnd+' '+yzone
  339.       END;
  340.  
  341.     IF ydupe=True THEN ysrprt:=ysrprt+' -DUPLICATE-  0'
  342.     ELSE
  343.       IF ynclb=1 THEN ysrprt:=ysrprt+'      '+yzone+'   '+ypts
  344.       ELSE
  345.         IF ynzne=1 THEN
  346.           ysrprt:=ysrprt+'  '+yrzone+'          '+ypts
  347.         ELSE
  348.           ysrprt:=ysrprt+'              '+ypts;
  349.  
  350.     ycall:='  '+ycall;
  351.     WHILE Length(ycall)<14 DO ycall:=ycall+' ';
  352.  
  353.     Writeln(iaru,yiband:5,ym,ydate,'  ',yutc,ycall,ysrprt);
  354.     IF (yqsoc=10) OR (yqsoc=20) OR (yqsoc=30) THEN Writeln(iaru,' ');
  355.     END;
  356.  
  357.  
  358.   {    Writeln(yctlog)    }     { This command displays the original log }
  359.       END
  360.     END;
  361.  
  362.   IF yqsoc>0 THEN LogF(ydup,yqsoc,ypzn,yphq,yppts,True);
  363.   
  364.   Close(iaru)
  365. END;
  366.  
  367. {----------------------------------------------------- writing summary -----}
  368.  
  369. PROCEDURE SumOut;
  370. VAR yn  : INTEGER;
  371.     yb  : ARRAY[0..7] OF STRING;
  372.     sum : TEXT;
  373.     yso : STRING;
  374.     ytot : LongInt;
  375. BEGIN
  376.   yb[1]:=' 160   ';
  377.   yb[2]:='  80   ';
  378.   yb[3]:='  40   ';
  379.   yb[4]:='  20   ';
  380.   yb[5]:='  15   ';
  381.   yb[6]:='  10   ';
  382.   yb[7]:=' Tot   ';
  383.  
  384.   Assign (sum,yfile+'.WCS');
  385.   Rewrite(sum);
  386.  
  387.   yso:='BAND    QSO    ZONES      HQs     POINTS      TOTAL';
  388.   Writeln(sum,yso);
  389.   Writeln(sum,' ');
  390.  
  391.   FOR yn:=1 TO 7 DO
  392.     BEGIN
  393.     ytot:=ysump[yn] * (ysumz[yn]+ysumc[yn]);
  394.     yso:=yso+yb[yn];
  395.     Write  (sum,yb[yn],ysumq[yn]:4,'      ',ysumz[yn]:3,'      ');
  396.     Writeln(sum,ysumc[yn]:3,'   ',ysump[yn]:8,'  ',ytot:9);
  397.     END;
  398.   Writeln(sum,' ');
  399.   Writeln(sum,yvers);
  400.   Close(sum)
  401. END;
  402.  
  403.  
  404. {----------------------------------------------------- MAIN PGM ------------}
  405.  
  406. BEGIN
  407.    IF ParamCount <> 3 THEN
  408.    Writeln ('***ERROR in PARAMETER')
  409. ELSE
  410.    Ini;
  411.    In_Hq;
  412.    ReadLog;
  413.    SumOut
  414. END.
  415.